-module(templel_scan).
-export([string/1,string/2,tokens/3,scan/8,format_error/1]).

-import(lists, [reverse/1]).

-include_lib("eunit/include/eunit.hrl").
-include_lib("../include/templ.hrl").

-define(IsHex(H), (((H >= $0) and (H =< $9)) or ((H >= $A) and (H =< $F)))).
-define(IsHexGT(H, L), (((H >= L) and (H =< $9)) or ((H >= $A) and (H =< $F)))).


%% format_error(Error)
%%  Return a string describing the error.

format_error({string,Quote,Head}) ->
    ["unterminated " ++ string_thing(Quote) ++
     " starting with " ++ io_lib:write_string(Head,Quote)];
format_error({illegal,Type}) -> io_lib:fwrite("illegal ~w", [Type]);
format_error(char) -> "unterminated character";
format_error(scan) -> "premature end";
format_error({base,Base}) -> io_lib:fwrite("illegal base '~w'", [Base]);
format_error(float) -> "bad float";
%%
format_error(Other) -> io_lib:write(Other).

string_thing($') -> "atom";   %' Stupid Emacs
string_thing(_) -> "string".

%% string(CharList, StartPos)
%%  Takes a list of characters and tries to tokenise them.
%%
%%  Returns:
%%	{ok,[Tok]}
%%	{error,{ErrorPos,?MODULE,What},EndPos}

string(Cs) ->
    string(Cs, 1).

string(Cs, Pos) when is_list(Cs), is_integer(Pos) ->
%     %% Debug replacement line for chopping string into 1-char segments
%     scan([], [], [], Pos, Cs, [], []).
    scan(Cs, [], [], ?InitPos(Pos), [], [], ?RDelim, []).


%% Scan utils.
%%

%% String
done(eof, [], Toks, Pos, eos) ->
    {ok,reverse(Toks),?GetPos(Pos)};
done(eof, Errors, _Toks, Pos, eos) ->
    {Error,ErrorPos} = lists:last(Errors),
    {error,{ErrorPos,?MODULE,Error},?GetPos(Pos)};
done(Cs, Errors, Toks, Pos, eos) ->
    main_scan(Cs, [], Toks, Pos, eos, Errors, ?RDelim, []);
% %% Debug clause for chopping string into 1-char segments
% done(Cs, Errors, Toks, Pos, [H|T], Fun) ->
%    Fun(Cs++[H], [], Toks, Pos, T, Errors);
done(Cs, Errors, Toks, Pos, []) ->
    main_scan(Cs++eof, [], Toks, Pos, eos, Errors, ?RDelim, []);
%% Stream
done(Cs, [], [{dot,_}|_]=Toks, Pos, io) ->
    {done,{ok,reverse(Toks),?GetPos(Pos)},Cs};
done(Cs, [], [_|_], Pos, io) ->
    {done,{error,{Pos,?MODULE,scan},?GetPos(Pos)},Cs};
done(Cs, [], [], Pos, eof) ->
    {done,{eof,?GetPos(Pos)},Cs};
done(Cs, [], [{dot,_}|_]=Toks, Pos, eof) ->
    {done,{ok,reverse(Toks),?GetPos(Pos)},Cs};
done(Cs, [], _Toks, Pos, eof) ->
    {done,{error,{Pos,?MODULE,scan},?GetPos(Pos)},Cs};
done(Cs, Errors, _Toks, Pos, io) ->
    {Error,ErrorPos} = lists:last(Errors),
    {done,{error,{ErrorPos,?MODULE,Error},?GetPos(Pos)},Cs};
done(Cs, Errors, _Toks, Pos, eof) ->
    {Error,ErrorPos} = lists:last(Errors),
    {done,{error,{ErrorPos,?MODULE,Error},?GetPos(Pos)},Cs}.


%% Frontend of scan
%%
scan([$*|Cs], CStack, Toks=[{l_delim,_}|_], Pos, State, Errors, Delim, DStack) ->
	pre_scan_comment(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack);
scan(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack) ->
	pre_scan_delim(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack, fun main_scan/8).


%% Scan for a comment
%%
pre_scan_comment([$*|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
	pre_scan_delim(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack, fun pre_scan_comment/8);
pre_scan_comment([_|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
	pre_scan_comment(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack).


%% Scan for a delimiter
%%
pre_scan_delim([C|Cs], CStack, Toks, Pos, State, Errors, [DC|DCs], DStack, Func) 
  when C =:= DC ->
	case DStack of
		[] -> pre_scan_delim(Cs, CStack, Toks, Pos, State, Errors, DCs, [C,Pos], Func);
		_  -> pre_scan_delim(Cs, CStack, Toks, Pos, State, Errors, DCs, [C|DStack], Func)
	end;
pre_scan_delim(Cs, _CStack, Toks, Pos, State, Errors, [], _DStack, _Func) ->
	Parent = ?PopPos(Pos),
	case Parent of
		[] -> done(eof, Errors, [{rdelim,Pos}|Toks], Pos, eos);
		_  -> 
			P = ?IncPos(Parent),
			templ_scan:scan(Cs, [], [{r_delim,P}|Toks], P, State, Errors, ?LDelim, [])
	end;
pre_scan_delim(Cs, _CStack, Toks, Pos, State, Errors, _Delim, [], Func) ->
	Func(Cs, [], Toks, Pos, State, Errors, ?RDelim, []);
pre_scan_delim(Cs, _CStack, Toks, Pos, State, Errors, _Delim, DStack, Func) ->
    [StartPos|Buf] = reverse(DStack),
	Func(Buf++Cs, [], Toks, ?ResetPos(Pos, StartPos), State, Errors, ?RDelim, []).


%% the actual scan loop
%% CStack is assumed to be [].

main_scan([$\n|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) -> % Newline - skip
    scan(Cs, CStack, Toks, ?IncPos(Pos), State, Errors, Delim, DStack);
main_scan([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C >= $\000, C =< $\s ->                          % Control chars - skip
    scan(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack);
main_scan([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C >= $\200, C =< $\240 ->                        % Control chars -skip
    scan(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack);

main_scan([C|Cs], _CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C >= $a, C =< $z ->                              % Names
    sub_scan_name(Cs, [C], Toks, Pos, State, Errors, Delim, DStack);
main_scan([C|Cs], _CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C >= $A, C =< $Z ->                              % Names
    sub_scan_name(Cs, [C], Toks, Pos, State, Errors, Delim, DStack);

main_scan([C|Cs], _CStack, Toks, Pos, State, Errors, Delim, DStack)
    when C >= $0, C =< $9; 
         C =:= $- ->                                    % Numbers
    scan_int(Cs, [C], Toks, Pos, State, Errors, Delim, DStack);

main_scan([$"|Cs], _CStack, Toks, Pos, State, Errors, Delim, DStack) ->      % String
    scan_string(Cs, [$",Pos], Toks, Pos, State, Errors, Delim, DStack);

main_scan([C1,$==C2|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C1 =:= $=; C1 =:= $<; C1 =:= $>; C1 =:= $! ->    % Logical operators
    scan(Cs, CStack, [{list_to_atom([C1,C2]),Pos}|Toks], Pos, State, Errors, Delim, DStack);
main_scan([$&,$&|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan(Cs, CStack, [{'&&',Pos}|Toks], Pos, State, Errors, Delim, DStack);
main_scan([$|,$||Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan(Cs, CStack, [{'||',Pos}|Toks], Pos, State, Errors, Delim, DStack);

main_scan([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C =:= $.; C =:= $[; C =:= $]; C =:= $(; C =:= $); C =:= $,;
       C =:= $|; C =:= $$; C =:= $@; C =:= $<; C =:= $>; C =:= $!; C =:= $: ->
    scan(Cs, CStack, [{list_to_atom([C]),Pos}|Toks], Pos, State, Errors, Delim, DStack);

main_scan([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    more([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack, fun scan/8);

main_scan([], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    more([], CStack, Toks, Pos, State, Errors, Delim, DStack, fun scan/8);
main_scan(Eof, _CStack, Toks, Pos, State, Errors, _Delim, _DStack) ->
    done(Eof, Errors, Toks, Pos, State).


%% Scan for a name
%%
%% begin-with ::= [a-zA-Z], char ::= [a-zA-Z] | number | '_'
%%
sub_scan_name([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when C >= $a, C =< $z; 
       C >= $A, C =< $Z; 
       C >= $0, C =< $9;
       C =:= $_ ->
	sub_scan_name(Cs, [C|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_name([], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    more([], CStack, Toks, Pos, State, Errors, Delim, DStack, fun sub_scan_name/8);
sub_scan_name(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack) ->
	Name = reverse(CStack),
	Token = case Name of
				"true"    -> {boolean,Pos,true};
				"false"   -> {boolean,Pos,false};

				"if"      -> {if_,Pos};
				"let"     -> {let_,Pos};
				"is"      -> {is,Pos};
				"foreach" -> {foreach,Pos};
				"in"      -> {in,Pos};
				"else"    -> {else,Pos};
				"endif"   -> {endif,Pos};
				"endlet"  -> {endlet,Pos};
				"endforeach" -> {endforeach,Pos};
				"end"     -> {end_,Pos};

				_         -> {name,Pos,Name}
			end,
	scan(Cs, [], [Token|Toks], Pos, State, Errors, Delim, DStack).

%% Scan for a string
%%
scan_string([$"|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    [StartPos,$"|S] = reverse(CStack),
    scan(Cs, [], [{string,StartPos,S}|Toks], Pos, State, Errors, Delim, DStack);
scan_string([$\\|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    sub_scan_escape(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack);
%scan_string([nl|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
%    scan_string(Cs, ["hoge"|CStack], Toks, ?IncPos(Pos), State, Errors, Delim, DStack);
scan_string([$\n|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\n|CStack], Toks, ?IncPos(Pos), State, Errors, Delim, DStack);
scan_string([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [C|CStack], Toks, Pos, State, Errors, Delim, DStack);
scan_string([], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    more([], CStack, Toks, Pos, State, Errors, Delim, DStack, fun scan_string/8);
scan_string(Eof, CStack, _Toks, Pos, State, Errors, _Delim, _DStack) ->
    [StartPos,$"|S] = reverse(CStack),
    SS = string:substr(S, 1, 16),
    done(Eof, [{{string,$",SS},StartPos}|Errors], [], Pos, State).

%% Scan for a character escape sequence, in string. 
%% A string is a syntactical sugar list (e.g "abc") 
%%
%% \X - escape sequences
sub_scan_escape([$"|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$"|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$\\|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\\|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$/|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$/|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$b|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\b|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$f|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\f|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$n|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\n|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$r|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\r|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$t|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    scan_string(Cs, [$\t|CStack], Toks, Pos, State, Errors, Delim, DStack);
%% \u<4> hex digits - escaped unicode chars
% TODO bit演算子を使う
sub_scan_escape([$u,H1,H2,H3,H4|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when H1 == $0, H2 == $0, H3 >= $0, H3 =< $7, ?IsHex(H4) ->
	H3v = read_hex(H3), H4v = read_hex(H4),
    Val = H3v*16 + H4v,
    scan_string(Cs, [Val|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$u,H1,H2,H3,H4|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when H1 == $0, H2 == $0, ?IsHexGT(H3, $8), ?IsHex(H4) ->
	H3v = read_hex(H3), H4v = read_hex(H4),
    V1 = 192 + (H3v div 4),
    V2 = 128 + (H3v rem 4)*16 + H4v,
    scan_string(Cs, [V2,V1|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$u,H1,H2,H3,H4|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when H1 == $0, H2 >= $1, H2 =< $7, ?IsHex(H3), ?IsHex(H4) ->
	H2v = read_hex(H2), H3v = read_hex(H3), H4v = read_hex(H4),
    V1 = 192 + H2v*4 + (H3v div 4),
    V2 = 128 + (H3v rem 4)*16 + H4v,
    scan_string(Cs, [V2,V1|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$u,H1,H2,H3,H4|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when H1 == $0, ?IsHexGT(H2, $8), ?IsHex(H3), ?IsHex(H4) ->
	H2v = read_hex(H2), H3v = read_hex(H3), H4v = read_hex(H4),
    V1 = 224,
    V2 = 128 + H2v*4 + (H3v div 4),
    V3 = 128 + (H3v rem 4)*16 + H4v,
    scan_string(Cs, [V3,V2,V1|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$u,H1,H2,H3,H4|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when ?IsHexGT(H1, $1), ?IsHex(H2), ?IsHex(H3), ?IsHex(H4) ->
	H1v = read_hex(H1), H2v = read_hex(H2), 
	H3v = read_hex(H3), H4v = read_hex(H4),
    V1 = 224 + H1v,
    V2 = 128 + H2v*4 + (H3v div 4),
    V3 = 128 + (H3v rem 4)*16 + H4v,
    scan_string(Cs, [V3,V2,V1|CStack], Toks, Pos, State, Errors, Delim, DStack);
sub_scan_escape([$u,H1,H2,H3]=Cs, CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when ?IsHex(H1), ?IsHex(H2), ?IsHex(H3) ->
    more(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack, fun sub_scan_escape/8);
sub_scan_escape([$u,H1,H2]=Cs, CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when ?IsHex(H1), ?IsHex(H2) ->
    more(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack, fun sub_scan_escape/8);
sub_scan_escape([$u,H1]=Cs, CStack, Toks, Pos, State, Errors, Delim, DStack) 
  when ?IsHex(H1) ->
    more(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack, fun sub_scan_escape/8);
%%
sub_scan_escape([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
	more([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack, fun sub_scan_escape/8);
sub_scan_escape([], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    more([], CStack, Toks, Pos, State, Errors, Delim, DStack, fun sub_scan_escape/8);
sub_scan_escape(Eof, CStack, _Toks, Pos, State, Errors, _Delim, _DStack) ->
    [StartPos,$"|S] = reverse(CStack),
    SS = string:substr(S, 1, 16),
    done(Eof, [{{string,$",SS},StartPos}|Errors], [], Pos, State).

read_hex(H) when H >= $0, H =< $9 -> 
	{V,_} = string:to_integer([H]), V;
read_hex(H) ->
	{_,[V],_} = io_lib:fread("~16u", [H]), V.


scan_int(Cs, [$0], Toks, Pos, State, Errors, Delim, DStack) ->
    scan(Cs, [], [{integer,Pos,0}|Toks], Pos, State, Errors, Delim, DStack);
scan_int([$0|Cs], [$-], Toks, Pos, State, Errors, Delim, DStack) ->
    scan(Cs, [], [{integer,Pos,-0}|Toks], Pos, State, Errors, Delim, DStack);
scan_int([C|Cs], CStack, Toks, Pos, State, Errors, Delim, DStack) when C >= $0, C =< $9 ->
    scan_int(Cs, [C|CStack], Toks, Pos, State, Errors, Delim, DStack);
scan_int([], CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    more([], CStack, Toks, Pos, State, Errors, Delim, DStack, fun scan_int/8);
scan_int(Cs, CStack, Toks, Pos, State, Errors, Delim, DStack) ->
    case catch list_to_integer(reverse(CStack)) of
		N when is_integer(N) ->
			scan(Cs, [], [{integer,Pos,N}|Toks], Pos, State, Errors, Delim, DStack);
		_ ->
			scan(Cs, [], Toks, Pos, State, [{{illegal,integer},Pos}|Errors], Delim, DStack)
    end.
